library(tidyverse)
library(rlang)Data Masking(1)
rlang
tidyverse
什么是data-masking
Data-masking 是一种允许直接调用数据框中的列名作为一个正常环境变量的技术。例如下例，使用with函数实现该目的：
# Unmasked programming
mean(mtcars$cyl + mtcars$am)
#> [1] 6.59375
# Referring to columns is an error - Where is the data?
mean(cyl + am)
#> Error: object 'cyl' not found
# Data-masking
with(mtcars, mean(cyl + am))
#> [1] 6.59375data-masking 带来的问题
虽然 data-masking 技术使得操作数据框十分方便，但会增加创造函数的困难。例如下面例子中的var,var2在函数bodys中并不表示参数，而是被 data-masking 解释为数据data中的列。
my_mean <- function(data, var1, var2) {
dplyr::summarise(data, mean(var1 + var2))
}
my_mean(mtcars, cyl, am)
#> Error in `dplyr::summarise()`:
#> ℹ In argument: `mean(var1 + var2)`.
#> Caused by error:
#> ! object 'cyl' not found使用{{可以避免 data-masking 带来的问题，因为它会把var1和var2解释为参数而不是数据data中的列。
my_mean <- function(data, var1, var2) {
dplyr::summarise(data, mean({{ var1 }} + {{ var2 }}))
}
my_mean(mtcars, cyl, am)
#> mean(cyl + am)
#> 1 6.59375masking 具体是什么意思？
从上面的例子中也可以看出，所谓的masking，就是词法作用域的优先级。相同变量名在data-masking中会被优先解释为数据框中的列，而非外部环境中的变量。rlang 包所构建的tidy eval框架提供了pronouns来声明变量的所属环境。
cyl <- 1000
mtcars %>%
dplyr::summarise(
mean_data = mean(.data$cyl),
mean_env = mean(.env$cyl)
)
#> mean_data mean_env
#> 1 6.1875 1000data-masking 如何工作？
data-masking 依赖R语言的三个特点：
defuse 变量，如 base R 中的
substitute()、rlang 中的enquo(),{{等。first class environment。环境在R中一个类似list的特殊对象，R 允许将list或dataframe转换为环境。
as.environment(mtcars)
#> <environment: 0x000001e1585adca0>- 评估函数——
eval()(base)、eval_tidy()(rlang)。
也即：先将变量名转换为defused状态，变得不可用，然后将dataframe转换为环境，最后在转换后的环境中重新评估变量。
data-masking 编程模式
诚如上述，在函数中使用 data-masking，需要特殊处理才能正确解析参数。在rlang官网上，有四种解决方案。
forwarding pattern
使用{{
{{用来直接解析单个参数，并且不丢失原有的信息（观察下面例子列名）。
my_summarise <- function(data, var) {
data %>% dplyr::summarise({{ var }})
}
mtcars %>% my_summarise(mean(cyl))
#> mean(cyl)
#> 1 6.1875
x <- "cyl"
mtcars %>% my_summarise(mean(.data[[x]]))
#> mean(.data[["cyl"]])
#> 1 6.1875...
... 不要求额外的语法设置，可以直接使用，用来解析多个参数。
my_group_by <- function(.data, ...) {
.data %>% dplyr::group_by(...)
}
mtcars %>% my_group_by(cyl = cyl * 100, am)
#> # A tibble: 32 × 11
#> # Groups: cyl, am [6]
#> mpg cyl disp hp drat wt qsec vs am gear carb
#> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
#> 1 21 600 160 110 3.9 2.62 16.5 0 1 4 4
#> 2 21 600 160 110 3.9 2.88 17.0 0 1 4 4
#> 3 22.8 400 108 93 3.85 2.32 18.6 1 1 4 1
#> 4 21.4 600 258 110 3.08 3.22 19.4 1 0 3 1
#> 5 18.7 800 360 175 3.15 3.44 17.0 0 0 3 2
#> 6 18.1 600 225 105 2.76 3.46 20.2 1 0 3 1
#> # ℹ 26 more rows
my_select <- function(.data, ...) {
.data %>% dplyr::select(...)
}
mtcars %>% my_select(starts_with("c"), vs:carb)
#> cyl carb vs am gear
#> Mazda RX4 6 4 0 1 4
#> Mazda RX4 Wag 6 4 0 1 4
#> Datsun 710 4 1 1 1 4
#> Hornet 4 Drive 6 1 1 0 3
#> Hornet Sportabout 8 2 0 0 3
#> Valiant 6 1 1 0 3
#> Duster 360 8 4 0 0 3
#> Merc 240D 4 2 1 0 4
#> Merc 230 4 2 1 0 4
#> Merc 280 6 4 1 0 4
#> Merc 280C 6 4 1 0 4
#> Merc 450SE 8 3 0 0 3
#> Merc 450SL 8 3 0 0 3
#> Merc 450SLC 8 3 0 0 3
#> Cadillac Fleetwood 8 4 0 0 3
#> Lincoln Continental 8 4 0 0 3
#> Chrysler Imperial 8 4 0 0 3
#> Fiat 128 4 1 1 1 4
#> Honda Civic 4 2 1 1 4
#> Toyota Corolla 4 1 1 1 4
#> Toyota Corona 4 1 1 0 3
#> Dodge Challenger 8 2 0 0 3
#> AMC Javelin 8 2 0 0 3
#> Camaro Z28 8 4 0 0 3
#> Pontiac Firebird 8 2 0 0 3
#> Fiat X1-9 4 1 1 1 4
#> Porsche 914-2 4 2 0 1 5
#> Lotus Europa 4 2 1 1 5
#> Ford Pantera L 8 4 0 1 5
#> Ferrari Dino 6 6 0 1 5
#> Maserati Bora 8 8 0 1 5
#> Volvo 142E 4 2 1 1 4有些函数会将多个参数同时传递给函数中的一个参数，如下例所示。此时c()生成的不是向量，而是tidy-select组合。
my_pivot_longer <- function(.data, ...) {
.data %>% tidyr::pivot_longer(c(...))
}
mtcars %>% my_pivot_longer(starts_with("c"), vs:carb)
#> # A tibble: 160 × 8
#> mpg disp hp drat wt qsec name value
#> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <chr> <dbl>
#> 1 21 160 110 3.9 2.62 16.5 cyl 6
#> 2 21 160 110 3.9 2.62 16.5 carb 4
#> 3 21 160 110 3.9 2.62 16.5 vs 0
#> 4 21 160 110 3.9 2.62 16.5 am 1
#> 5 21 160 110 3.9 2.62 16.5 gear 4
#> 6 21 160 110 3.9 2.88 17.0 cyl 6
#> # ℹ 154 more rowsname pattern
使用tidy eval框架提供的pronouns，可以直接使用参数。
my_mean <- function(data, var) {
data %>% dplyr::summarise(mean = mean(.data[[var]]))
}
my_mean(mtcars, "cyl")
#> mean
#> 1 6.1875遗憾的是，这种方法只能处理单个参数的情况。
mtcars %>% dplyr::summarise(.data[c("cyl", "am")])
#> Error in `dplyr::summarise()`:
#> ℹ In argument: `.data[c("cyl", "am")]`.
#> Caused by error in `.data[c("cyl", "am")]`:
#> ! `[` is not supported by the `.data` pronoun, use `[[` or $ instead.bridge pattern
使用中间桥梁函数解析参数，如across()、transmute()等
across()
my_group_by <- function(data, var) {
data %>% dplyr::group_by(across({{ var }}))
}
mtcars %>% my_group_by(starts_with("c"))
#> # A tibble: 32 × 11
#> # Groups: cyl, carb [9]
#> mpg cyl disp hp drat wt qsec vs am gear carb
#> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
#> 1 21 6 160 110 3.9 2.62 16.5 0 1 4 4
#> 2 21 6 160 110 3.9 2.88 17.0 0 1 4 4
#> 3 22.8 4 108 93 3.85 2.32 18.6 1 1 4 1
#> 4 21.4 6 258 110 3.08 3.22 19.4 1 0 3 1
#> 5 18.7 8 360 175 3.15 3.44 17.0 0 0 3 2
#> 6 18.1 6 225 105 2.76 3.46 20.2 1 0 3 1
#> # ℹ 26 more rowsmy_group_by <- function(.data, ...) {
.data %>% dplyr::group_by(across(c(...)))
}
mtcars %>% my_group_by(starts_with("c"), vs:gear)
#> # A tibble: 32 × 11
#> # Groups: cyl, carb, vs, am, gear [15]
#> mpg cyl disp hp drat wt qsec vs am gear carb
#> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
#> 1 21 6 160 110 3.9 2.62 16.5 0 1 4 4
#> 2 21 6 160 110 3.9 2.88 17.0 0 1 4 4
#> 3 22.8 4 108 93 3.85 2.32 18.6 1 1 4 1
#> 4 21.4 6 258 110 3.08 3.22 19.4 1 0 3 1
#> 5 18.7 8 360 175 3.15 3.44 17.0 0 0 3 2
#> 6 18.1 6 225 105 2.76 3.46 20.2 1 0 3 1
#> # ℹ 26 more rowsmy_group_by <- function(data, vars) {
data %>% dplyr::group_by(across(all_of(vars)))
}
mtcars %>% my_group_by(c("cyl", "am"))
#> # A tibble: 32 × 11
#> # Groups: cyl, am [6]
#> mpg cyl disp hp drat wt qsec vs am gear carb
#> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
#> 1 21 6 160 110 3.9 2.62 16.5 0 1 4 4
#> 2 21 6 160 110 3.9 2.88 17.0 0 1 4 4
#> 3 22.8 4 108 93 3.85 2.32 18.6 1 1 4 1
#> 4 21.4 6 258 110 3.08 3.22 19.4 1 0 3 1
#> 5 18.7 8 360 175 3.15 3.44 17.0 0 0 3 2
#> 6 18.1 6 225 105 2.76 3.46 20.2 1 0 3 1
#> # ℹ 26 more rowstransmute()
my_pivot_longer <- function(data, ...) {
# Forward `...` in data-mask context with `transmute()`
# and save the inputs names
inputs <- dplyr::transmute(data, ...)
names <- names(inputs)
# Update the data with the inputs
data <- dplyr::mutate(data, !!!inputs)
# Select the inputs by name with `all_of()`
tidyr::pivot_longer(data, cols = all_of(names))
}
mtcars %>% my_pivot_longer(cyl, am = am * 100)
#> # A tibble: 64 × 11
#> mpg disp hp drat wt qsec vs gear carb name value
#> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <chr> <dbl>
#> 1 21 160 110 3.9 2.62 16.5 0 4 4 cyl 6
#> 2 21 160 110 3.9 2.62 16.5 0 4 4 am 100
#> 3 21 160 110 3.9 2.88 17.0 0 4 4 cyl 6
#> 4 21 160 110 3.9 2.88 17.0 0 4 4 am 100
#> 5 22.8 108 93 3.85 2.32 18.6 1 4 1 cyl 4
#> 6 22.8 108 93 3.85 2.32 18.6 1 4 1 am 100
#> # ℹ 58 more rows使用transmute()创建新的数据框，然后提取name，最后更新数据框。
Transformation patterns
对多个参数执行相同的操作，有下面两种类型：
Transforming inputs with across()
my_mean <- function(data, ...) {
data %>% dplyr::summarise(across(c(...), ~ mean(.x, na.rm = TRUE)))
}
mtcars %>% my_mean(cyl, carb)
#> cyl carb
#> 1 6.1875 2.8125
mtcars %>% my_mean(foo = cyl, bar = carb)
#> foo bar
#> 1 6.1875 2.8125
mtcars %>% my_mean(starts_with("c"), mpg:disp)
#> cyl carb mpg disp
#> 1 6.1875 2.8125 20.09062 230.7219Transforming inputs with if_all() and if_any()
filter_non_baseline <- function(.data, ...) {
.data %>% dplyr::filter(if_all(c(...), ~ .x != min(.x, na.rm = TRUE)))
}
mtcars %>% filter_non_baseline(vs, am, gear)
#> mpg cyl disp hp drat wt qsec vs am gear carb
#> Datsun 710 22.8 4 108.0 93 3.85 2.320 18.61 1 1 4 1
#> Fiat 128 32.4 4 78.7 66 4.08 2.200 19.47 1 1 4 1
#> Honda Civic 30.4 4 75.7 52 4.93 1.615 18.52 1 1 4 2
#> Toyota Corolla 33.9 4 71.1 65 4.22 1.835 19.90 1 1 4 1
#> Fiat X1-9 27.3 4 79.0 66 4.08 1.935 18.90 1 1 4 1
#> Lotus Europa 30.4 4 95.1 113 3.77 1.513 16.90 1 1 5 2
#> Volvo 142E 21.4 4 121.0 109 4.11 2.780 18.60 1 1 4 2